home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 6 / FM Towns Free Software Collection 6.iso / t_os / oekakimi / oekakimi.bas < prev    next >
BASIC Source File  |  1993-07-08  |  39KB  |  872 lines
  1. 10 '********************************************************************
  2. 20 '    お絵描きＭＩＸ --Special MAP Mode-- V1.2104
  3. 30 '           F-BASIC386 V1.1 L21以降専用   Copyright(C) おこめ 1993
  4. 40 '********************************************************************
  5. 50 CLS:LOCATE 30,12:PRINT "お絵描きＭＩＸ"
  6. 60 LOCATE 27,13:PRINT "--Special MAP Mode--"
  7. 70 CLEAR ,,512,FRE(4)-80000,0:ON ERROR GOTO *ERR
  8. 80 DEFINT A-F,H-Z:MOUSE 0:KI=22-1
  9. 90 DIM B(65535),VA(10911),B$(255),ER$(127),ER(10),ERM(12927):GOSUB *ERRM
  10. 100 DIM A(KI),VZ(32767),D(32767),P(127),I&(255),C$(10,10),CX(10),CX2(10)
  11. 110 DIM M(2),EGX(5),EGY(5),EM(4):V&=FRE(3)\2-20:DIM V(V&)
  12. 120 A(1)=-1:GET@A(0,0)-(0,0),A:IF A(1)=0 THEN MODE=0 ELSE MODE=2
  13. 130 L=3:XN2=8*2^L:YN2=XN2:MKNO=1:MNO=2:EG=16:V2=-1:MX55=1:MY55=1
  14. 140 FOR I=0 TO 4:READ EGX(I),EGY(I):NEXT:SCREEN@1
  15. 150 FOR I=1 TO 4:EM(I)=EM(I-1)+(4*2^I)^2/2:NEXT
  16. 160 DATA 455,50,447,59,431,76,399,109,464,45
  17. 170 DEF FNSX(MX)=((MX-XK)\XB)+WX:DEF FNSY(MY)=((MY-YK)\YB)+WY
  18. 180 DEF FNMX(MX)=((MX-XK)\XB)*XB+XK-1:DEF FNMY(MY)=((MY-YK)\YB)*YB+YK
  19. 190 *S1 SCREEN@MODE:COLOR 7,0,7,4:CLS:WIDTH 80,25:CONSOLE 24,1,0:GOSUB *W
  20. 200 A$=CHR$(127,255,63,255,31,255,15,255,7,255,3,255,1,255,0,255,0,127,0,63,0,31,0,31,0,127,0,255,16,255,56,255)
  21. 210 B$=CHR$(0,0,0,0,64,0,96,0,48,0,88,0,60,0,94,0,47,0,95,128,47,0,84,0,70,0,2):MOUSE 2,A$,B$
  22. 220 *GA LINE(0,0)-(639,479),PSET,%7+MODE*51,BF
  23. 230 RESTORE 360
  24. 240 READ I:IF I=-1 THEN 290
  25. 250 IF MODE=0 AND I=12 THEN 240
  26. 260 LINE(I*40+4,4)-STEP(33,33),PSET,0,BF
  27. 270 LINE STEP(-2,-2)-STEP(-33,-33),PSET,0,BF,7
  28. 280 GOTO 240
  29. 290 SYMBOL(5,11),"MODE",.9!,1,7,,,8
  30. 300 IF MODE=2 THEN SYMBOL(487,11),"MAP",1,1,7,,,8
  31. 310 LINE(525,13)-(533,21),PSET,0,B
  32. 320 LINE(535,5)-(551,21),PSET,0,B
  33. 330 SYMBOL(565,3),"CD",.9!,1,7,,,8
  34. 340 SYMBOL(565,19),"PLAY",.9!,1,7,,,8
  35. 350 SYMBOL(602,11),"EXIT",.8!,1,7,,,15
  36. 360 DATA 0,12,13,14,15,-1
  37. 370 READ CX2(0):CX(0)=42
  38. 380 FOR X=1 TO CX2(0):READ C$(0,X),CX2(X)
  39. 390 CX(X)=CX(X-1)+KLEN(C$(0,X))*16+19
  40. 400 C$(X,0)=CHR$(0):FOR Y=1 TO CX2(X):READ C$(X,Y)
  41. 410 IF MODE=0 THEN C$(4,1)="256色変換" ELSE C$(4,1)="ビデオ取り込み"
  42. 420 IF LEN(C$(X,Y))>ASC(C$(X,0)) THEN C$(X,0)=CHR$(LEN(C$(X,Y)))
  43. 430 NEXT Y,X
  44. 440 LINE(600,50)-STEP(33,33),PSET,7,BF,0
  45. 450 FOR X=1 TO CX2(0)
  46. 460 LINE(CX(X-1),0)-(CX(X)-1,19),PSET,7,BF
  47. 470 LINE(CX(X-1)+2,2)-(CX(X)-2,18),PSET,0,BF
  48. 480 LINE(CX(X-1)+1,19)-(CX(X)-1,19),PSET,0
  49. 490 LINE(CX(X)-1,1)-(CX(X)-1,19),PSET,0
  50. 500 LINE(CX(X-1)+2,2)-(CX(X)-3,17),PSET,1,BF
  51. 510 SYMBOL(CX(X-1)+1-(X MOD 2)+12,5),C$(0,X),.75!,.75!,7:NEXT
  52. 520 DATA 4,ファイル,10,TIFF　 　読み込み,　　　   保存,モノクロ 保存
  53. 530 DATA 部分     保存,ﾓﾉｸﾛ部分 保存,32K色変換保存,TMENU.ICN読み込み
  54. 540 DATA 　       保存,MAP形式  読み込み,　       保存,編集窓,4,左回転
  55. 550 DATA 上下反転,左右反転,白黒反転,バッファ,5,アニメーション,上下反転
  56. 560 DATA 左右反転,上下縮小,左右縮小,画像処理,2,取,印刷
  57. 570 SYMBOL(40,20),"お絵描きＭＩＸ－"+AKCNV$(MID$(STR$(16+MODE*120),2))+"   Ｖ１.２102",1,1,0,,,1
  58. 580 MP0=0:MP1=0:GOSUB *MODE:GOSUB *EDP:GOSUB *拡大:GOSUB *WA
  59. 590 IF MODE=2 THEN *M2
  60. 600 FOR X=0 TO 7:FOR Y=0 TO 1
  61. 610 LINE(X*16,Y*17+400)-STEP(16,17),PSET,7,BF,%X+Y*8
  62. 620 NEXT Y,X:CX2(1)=CX2(1)-2:GOTO *M
  63. 630 *MODE WX=EGX(L):WY=EGY(L):BY=194:XK=81:YK=112:EGY(5)=BY
  64. 640 BX4=256:BX=640-BX4:BX3=BX4-1:BX2=BX+BX3:EGX(5)=BX
  65. 650 XN=XN2-1:XB=256\XN2:XB2=XB-1:XK3=XN2*XB:XK2=XK+XK3-1
  66. 660 BY4=256:BY3=BY4-1:BY2=BY+BY3
  67. 670 YN=YN2-1:YB=256\YN2:YB2=YB-1:YK3=YN2*YB:YK2=YK+YK3-1
  68. 680 EV=INT(V&/BX4/BY4*2*(1-(MODE=0)))
  69. 690 JJ!=BX4/2/(1-(MODE=0))*BY4^2/V&
  70. 700 IF V>EV THEN V=0
  71. 710 RETURN
  72. 720 *M2 FOR Y=0 TO 2:FOR X=0 TO 7:LINE(16*X+1,401+Y*11)-STEP(15,10),PSET,[-32*X*(Y=0),-32*X*(Y=1),-32*X*(Y=2)],BF:NEXT
  73. 730 LINE(16*M(Y)+2,402+Y*11)-STEP(13,8),XOR,7,B:NEXT
  74. 740 LINE(201,401)-STEP(129,33),PSET,0,BF
  75. 750 LINE(200,400)-STEP(129,33),PSET,7,B
  76. 760 FOR X=0 TO 31
  77. 770 LINE(201+X*4,401)-STEP(3,31),OR,%X,BF
  78. 780 LINE(201,401+X)-STEP(127,0),OR,%(X\4)*32:NEXT
  79. 790 LINE(130,401)-(145,433),PSET,[32*M(0),32*M(1),32*M(2)],BF
  80. 800 LINE(0,400)-(129,434),PSET,7,B:LINE(129,400)-(146,434),PSET,7,B
  81. 810 *M LINE(150,400)-(165,434),PSET,7,BF,0:LINE(170,400)-(185,434),PSET,7,BF,0
  82. 820 FOR X=0 TO 7:CIRCLE(X*16+8,384),X,7,1,,,F:NEXT:GOSUB *MPE
  83. 830 RESTORE 840:FOR X=0 TO KI:LINE((X MOD 2)*32+2,(X\2)*20+50)-STEP(32,20),PSET,0,BF:READ A(X):LINE STEP(-34,-22)-STEP(32,20),PSET,0,BF,7-A(X):NEXT
  84. 840 DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,2,1,1,1,1,1,1,1,1
  85. 850 FOR Y=0 TO 3:FOR X=0 TO 1
  86. 860 READ A$:SYMBOL(9+X*32,51+Y*20),A$,1,1,0:NEXT X,Y:PAINT(45,115),0
  87. 870 DATA ・,／,□,■,○,●,〇,〇
  88. 880 SYMBOL(2,145),"⇔",1,1,0,1
  89. 890 SYMBOL(18,131),"転",.9!,1,0:SYMBOL(35,131),"⇔転",.9!,1,0
  90. 900 SYMBOL(2,151),"COPY",.9!,1,0:SYMBOL(35,151),"MOVE",.9!,1,0
  91. 910 SYMBOL(2,171),"PAINT",.8!,1,0:SYMBOL(34,171),"SPOIT",.8!,1,0
  92. 920 SYMBOL(9,190),"⇔",1,1,0:SYMBOL(41,191),"☆",1,1,0
  93. 930 SYMBOL(2,211),"ｺﾋﾟｰ",1,1,0:SYMBOL(34,211),"ﾍﾟｰｽﾄ",.75!,1,0
  94. 940 SYMBOL(3,231),"楕円",.9!,1,0:SYMBOL(34,231),"色々",1,1,0
  95. 950 SYMBOL(3,251),"NEKO",.9!,1,0:SYMBOL(34,251),"FANTA",.8!,1,0
  96. 960 Z=MNO+13:GOSUB *MKCH:Z=MKNO:GOSUB *MKCH
  97. 970 MOUSE 1,320,240:GOSUB *ESCP
  98. 980 ER=0:GOSUB *MUON
  99. 990 A$=INKEY$:IF A$="" THEN GOSUB *MOUSE:GOTO 990
  100. 1000 GOSUB *MUSTP
  101. 1010 IF A$=CHR$(5) THEN GOSUB *CLS
  102. 1020 IF A$=CHR$(8) OR A$=CHR$(9) OR A$=CHR$(22) THEN GOSUB *ESC2
  103. 1030 IF A$=CHR$(11) THEN GOSUB *ESCG:V=0:V2=-1:GOSUB *ESCP:GOSUB *率:GOSUB *WA
  104. 1040 IF A$=CHR$(12) THEN GOSUB *BCLS
  105. 1050 IF A$=CHR$(16) THEN GOSUB *GMFSA
  106. 1060 IF A$=CHR$(19) THEN GOSUB *GMSAVE
  107. 1070 IF A$=CHR$(27) OR A$=CHR$(23) THEN GOSUB *ESC
  108. 1080 IF A$="*" THEN GOSUB *WA
  109. 1090 IF A$="!" THEN CD PLAY
  110. 1100 IF A$=CHR$(34) THEN CD STOP
  111. 1110 IF A$="%" THEN V(V&-V)=2:GOSUB *MAPM
  112. 1120 IF A$="&" THEN V(V&-V)=0:GOSUB *MAPM
  113. 1130 IF A$="'" THEN V(V&-V)=1:GOSUB *MAPM
  114. 1140 IF A$="-" THEN GOSUB *拡大
  115. 1150 IF A$="/" THEN GOSUB *率
  116. 1160 IF A$<"A" THEN 1180
  117. 1170 ON ASC(A$)-64 GOSUB *WQA,*反転,*CLS,*BCLS,*END,*SUD,*SLR,*B反転,*ICNL,*ANIM,*S回転,*GLOAD,*率,*B拡大,*ICNS,*変換,*WQU,*SROLL,*GSAVE,*BROLL,*DLOAD,*WAVEX,*WAVEY,*BLR,*B回転,*BUD
  118. 1180 IF A$="f" THEN GOSUB *FANT
  119. 1190 IF A$="h" THEN GOSUB *印刷
  120. 1200 IF A$="l" THEN GOSUB *MLOAD
  121. 1210 IF A$="m" THEN GOSUB *面積
  122. 1220 IF A$="p" AND MODE=2 THEN GOSUB *変換3
  123. 1230 IF A$="s" THEN GOSUB *GFSA
  124. 1240 IF A$>="1" AND A$=<"9" AND MODE=2 AND LEN(A$)=1 THEN GOSUB *BE
  125. 1250 GOTO 980
  126. 1260 *END GOSUB *ESCG:GOSUB *EDG:CONSOLE 0,25,0:END:MOUSE 0:RETURN *S1
  127. 1270 *MUSTP MUSW=0:MOUSE 1:RETURN
  128. 1280 *MUON MUSW=1:MOUSE 1,,,1:RETURN
  129. 1290 *WA LINE(XK-1,YK-1)-(XK2+1,YK2+1),PSET,7,B
  130. 1300 FOR I=2 TO YN-1 STEP 2:LINE(XK,YK+YB*I)-STEP(XB2+XB*XN,0),PSET,[127,127,127]:NEXT
  131. 1310 FOR I=2 TO XN-1 STEP 2:LINE(XK+XB*I,YK)-STEP(0,YB2+YB*YN),PSET,[127,127,127]:NEXT
  132. 1320 IF L<5 THEN LINE(WX-1,WY-1)-STEP(XN+2,YN+2),PSET,7,B
  133. 1330 GOTO *JN
  134. 1340 *拡大 GET@A(WX,WY)-(WX+XN,WY+YN),B
  135. 1350 IF V(V&-V)>0 THEN *M拡大
  136. 1360 PUT@A(XK,YK)-(XK+XN,YK+YN),B,,XK3/XN2,YK3/YN2:RETURN
  137. 1370 *字 LOCATE 0,24:PRINT SPC(79);:LOCATE 0,24
  138. 1380 *JN FOR I=0 TO 15
  139. 1390 SYMBOL(BX+(BX4\16)*I,BY-BY4\16),AKCNV$(HEX$(I)),BX4/256,BY4/256,7
  140. 1400 SYMBOL(BX-BX4\16,BY+(BY4\16)*I),AKCNV$(HEX$(I)),BX4/256,BY4/256,7
  141. 1410 NEXT:RETURN
  142. 1420 *ERR CLOSE:ER=ERR:STOP OFF
  143. 1430 IF ER=11 AND (ERL=5530 OR ERL=5540) THEN 1670
  144. 1440 IF ERL=7690 OR ERL=7720 THEN 1610
  145. 1450 IF ER=28 AND ERL=8450 THEN ER=127
  146. 1460 FOR RR=0 TO 3:ER(RR)=VIEW(RR):ER(RR+4)=WINDOW(RR):NEXT
  147. 1470 VIEW(140,115)-(395,215):WINDOW(0,0)-(255,100):GOSUB *MO
  148. 1480 BEEP:MOUSE 1,,,1:GET@A(0,0)-(255,100),ERM
  149. 1490 LINE(0,0)-(255,100),PSET,%8-MODE*4,BF,7
  150. 1500 LINE(2,2)-(33,33),PSET,%8-MODE*4,B
  151. 1510 LINE(2,80)-(60,98),PSET,%8-MODE*4,B
  152. 1520 SYMBOL(43,12),"ＥＲＲＯＲ",.75!,1,%8-MODE*4
  153. 1530 SYMBOL(148,12),"("+MID$(STR$(ERL),2)+")",.75!,1,%8-MODE*4
  154. 1540 SYMBOL(112,11),STR$(ERR),.75!,1,%8-MODE*4
  155. 1550 IF ERR=64 THEN SYMBOL(9,81),"実　行",.75!,1,%8-MODE*4:LINE(67,80)-(125,98),PSET,%8-MODE*4,B:SYMBOL(73,81),"取　消",.75!,1,%8-MODE*4:GOTO 1570
  156. 1560 SYMBOL(9,81),"確　認",.75!,1,%8-MODE*4
  157. 1570 SYMBOL(127-LEN(LEFT$(ER$(ER),40))*3+(LEN(ER$(ER))>40)*2,35),LEFT$(ER$(ER),40),.75!,1,%8-MODE*4
  158. 1580 SYMBOL(5,51),MID$(ER$(ER),41),.75!,1,%8-MODE*4
  159. 1590 E$=INKEY$:IF E$=CHR$(13) OR (MOUSE(2,0) AND 142<MOUSE(0) AND MOUSE(0)<200 AND 195<MOUSE(1) AND MOUSE(1)<213) THEN 1610
  160. 1600 IF (E$=CHR$(24) OR (MOUSE(2,0) AND 206<MOUSE(0) AND MOUSE(0)<264 AND 195<MOUSE(1) AND MOUSE(1)<213)) AND ERR=64 THEN 1640 ELSE 1590
  161. 1610 IF ERR=64 THEN KILL A$:ER=-1
  162. 1620 IF ERR=67 THEN KILL A$
  163. 1630 ON MUF GOSUB *MI,*MMI
  164. 1640 IF MUSW=1 THEN GOSUB *MUON ELSE GOSUB *MUSTP
  165. 1650 PUT@A(0,0)-(255,100),ERM
  166. 1660 VIEW(ER(0),ER(1))-(ER(2),ER(3)):WINDOW(ER(4),ER(5))-(ER(6),ER(7))
  167. 1670 STOP ON:IF ER=-1 THEN RESUME ELSE RESUME NEXT
  168. 1680 *ERRM
  169. 1690 ER$(15)="文字列の長さが許される範囲を超えています"
  170. 1700 ER$(127)="プリンタの準備ができていません"
  171. 1710 ER$(53)="入出力装置に異常が発生しました"
  172. 1720 ER$(55)="ファイルの記述に誤りがあります"
  173. 1730 ER$(63)="指定のファイルが見つかりません"
  174. 1740 ER$(64)="指定のファイルは既に存在しています"
  175. 1750 ER$(67)="ディスクに空き領域がありません"
  176. 1760 ER$(72)="指定されたディスク装置が使用可能な状態になっていません"
  177. 1770 ER$(73)="指定されたディスクは書き込みが禁止されています"
  178. 1780 RETURN
  179. 1790 *ZA INPUT "位置指定 XY=",A$:A$=RIGHT$("0"+A$,2)
  180. 1800 IF A$="0" THEN RETURN *字
  181. 1810 X=VAL("&H"+LEFT$(A$,1))*BX4/16:EX=BX+X
  182. 1820 Y=VAL("&H"+RIGHT$(A$,1))*BY4/16:EY=BY+Y
  183. 1830 RETURN
  184. 1840 *ESC GOSUB *ESCG:V=V+1+(EV-1=V)*EV:V2=-1:GOTO *ESCP
  185. 1850 *ESC2 GOSUB *ESCG:V=V-1-(V=0)*EV:V2=-1:GOTO *ESCP
  186. 1860 *ESCG IF V2>-1 THEN 1930
  187. 1870 IF V(V&-V)=1 AND MODE=2 THEN 1890
  188. 1880 GET@A(BX,BY)-(BX2,BY2),V,V*BX4*BY4/2/(1-(MODE=0)):GOTO 1920
  189. 1890 MOUSE 1:FOR ESR=0 TO 15
  190. 1900 GET@A(BX+ESR*BX4\16,BY)-(BX+(ESR+1)*BX4\16-1,BY2),V,V*BX4*BY4/2+BX4*BY4/32*ESR
  191. 1910 NEXT
  192. 1920 LINE(BX-32,BY+V*JJ!)-STEP(BX4/32,JJ!),PSET,0,BF:IF MUSW THEN *MUON ELSE RETURN
  193. 1930 GET@A(BX,BY)-(BX2,BY2),V,V2*BX4:RETURN
  194. 1940 *ESCP LINE(BX-BX4\16,BY-BY4\16)-(BX-1,BY-1),PSET,%7+MODE*51,BF
  195. 1950 IF V2>-1 THEN PUT@A(BX,BY)-(BX2,BY2),V,,,,,V2*BX4:GOTO 2030
  196. 1960 IF MODE=2 AND V(V&-V)=1 THEN 1980
  197. 1970 PUT@A(BX,BY)-(BX2,BY2),V,,,,,V*BX4*BY4/2/(1-(MODE=0)):GOTO 2010
  198. 1980 MOUSE 1:FOR ESR=0 TO 15
  199. 1990 PUT@A(BX+ESR*BX4\16,BY)-(BX+(ESR+1)*BX4\16-1,BY2),V,,,,,V*BX4*BY4/2+BX4*BY4/32*ESR
  200. 2000 NEXT:IF MUSW THEN GOSUB *MUON
  201. 2010 SYMBOL(BX-BX4\16,BY-BY4\16),AKCNV$(MID$(STR$(V+1),2)),BX4/256/(LEN(STR$(V+1))-1),BY4/256,4+V(V&-V)
  202. 2020 LINE(BX-32,BY+V*JJ!)-STEP(BX4/32,JJ!),PSET,7,BF
  203. 2030 IF L=5 THEN *拡大
  204. 2040 RETURN
  205. 2050 *GSAVE EX=BX2:EY=BY2:GOTO *GSA
  206. 2060 *GFSA PRINT "SAVE 範囲指定(右下) ";:GOSUB *ZA:EX=EX+15:EY=EY+15
  207. 2070 *GSA LINE INPUT "SAVE FILE NAME ",A$:IF A$="" OR A$=" " THEN *字
  208. 2080 IF INSTR(A$,".")=0 THEN A$=A$+".TIF"
  209. 2090 IF RIGHT$(A$,3)="PTN" THEN *PSA
  210. 2100 SAVE@ A$,(BX,BY)-(EX,EY):GOTO *字
  211. 2110 *PSA FOR I=0 TO 15
  212. 2120 GET@A(BX+I*BY4\16,BY)-(BX+(I+1)*BX4\16-1,BY2),D,2048*I:NEXT
  213. 2130 SAVE@ A$,D:GOTO *字
  214. 2140 *GMSAVE EX=BX4:EY=BY4:GOTO *GMSA
  215. 2150 *GMFSA PRINT "MONO SAVE 範囲指定(右下) ";:GOSUB *ZA:EX=X+16:EY=Y+16
  216. 2160 *GMSA LINE INPUT "MONO Save File Name ",A$
  217. 2170 IF A$="" OR A$=" " THEN *字
  218. 2180 IF INSTR(A$,".")=0 THEN A$=A$+".TIF"
  219. 2190 RESTORE 2290
  220. 2200 OPEN "O",#1,A$
  221. 2210 B$="":FOR I=0 TO 209:READ X:B$=B$+CHR$(X):NEXT
  222. 2220 MID$(B$,&H1F,2)=CHR$(EX AND 255,EX\256):MID$(B$,&H2B,2)=CHR$(EY AND 255,EY\256)
  223. 2230 PRINT #1,B$;STRING$(46,CHR$(0));
  224. 2240 I&=VARPTR(D%(0))
  225. 2250 FOR Y=BY TO BY+EY-1
  226. 2260 GET@(BX,Y)-(BX+EX-1,Y),D%,7
  227. 2270 FOR X=0 TO (EX+7)\8-1:PRINT #1,CHR$(PEEK(I&+X));:NEXT
  228. 2280 NEXT:CLOSE #1:GOTO *字
  229. 2290 DATA 73,73,42,0,8,0,0,0,15,0,255,0,3,0,1,0
  230. 2300 DATA 0,0,1,0,0,0,0,1,3,0,1,0,0,0,0,0
  231. 2310 DATA 0,0,1,1,3,0,1,0,0,0,0,0,0,0,2,1
  232. 2320 DATA 3,0,1,0,0,0,1,0,0,0,3,1,3,0,1,0
  233. 2330 DATA 0,0,1,0,0,0,6,1,3,0,1,0,0,0,0,0
  234. 2340 DATA 0,0,10,1,3,0,1,0,0,0,1,0,0,0,17,1
  235. 2350 DATA 4,0,1,0,0,0,0,1,0,0,18,1,3,0,1,0
  236. 2360 DATA 0,0,1,0,0,0,21,1,3,0,1,0,0,0,1,0
  237. 2370 DATA 0,0,24,1,3,0,1,0,0,0,0,0,0,0,25,1
  238. 2380 DATA 3,0,1,0,0,0,1,0,0,0,26,1,5,0,1,0
  239. 2390 DATA 0,0,194,0,0,0,27,1,5,0,1,0,0,0,202,0
  240. 2400 DATA 0,0,28,1,3,0,1,0,0,0,1,0,0,0,0,0
  241. 2410 DATA 0,0,75,0,0,0,1,0,0,0,75,0,0,0,1,0,0,0
  242. 2420 *GLOAD LINE INPUT "LOAD FILE NAME ";A$:IF A$="" OR A$=" " THEN *字
  243. 2430 IF INSTR(A$,".MAP") AND MODE=2 THEN *MLO
  244. 2440 IF INSTR(A$,".")=0 THEN A$=A$+".TIF"
  245. 2450 OPEN "I",#1,A$:CLOSE:IF ER>0 THEN *字
  246. 2460 IF RIGHT$(A$,3)="PTN" THEN *PLO
  247. 2470 IF RIGHT$(A$,3)<>"TIF" THEN *字
  248. 2480 OPEN "R",#1,A$:FOR I=0 TO 255:FIELD #1,I AS D$,1 AS B$(I):NEXT
  249. 2490 GET #1:OF=CVI(B$(5)+B$(4)):KOSU=CVI(B$(OF+1)+B$(OF))-1
  250. 2500 FOR I=0 TO KOSU
  251. 2510 TAG=12*I+2+OF:IF TAG>255 THEN GET #1:OF=OF-256:GOTO 2510
  252. 2520 TA=CVI(B$(TAG+1)+B$(TAG))
  253. 2530 IF TA=&H0100 THEN LX=CVL(B$(TAG+11)+B$(TAG+10)+B$(TAG+9)+B$(TAG+8))
  254. 2540 IF TA=&H0101 THEN LY=CVL(B$(TAG+11)+B$(TAG+10)+B$(TAG+9)+B$(TAG+8))
  255. 2550 IF TA=&H0102 THEN MD=CVL(B$(TAG+11)+B$(TAG+10)+B$(TAG+9)+B$(TAG+8))
  256. 2560 NEXT:CLOSE:I=0
  257. 2570 IF MD=4 AND MODE<>0 THEN MODE=0:I=1
  258. 2580 IF MD=8 AND MODE<>2 THEN MODE=2:I=1
  259. 2590 IF MD=16 THEN GOSUB *EDG:SCREEN@1:LOAD@ A$,(160-LX\2,128-LY\2):GOTO *変換2
  260. 2600 IF I=1 THEN SCREEN@MODE
  261. 2610 IF LX>BX4 OR LY>BY4 THEN *GL_A
  262. 2620 GOSUB *ESCP:LOAD@ A$,(BX,BY)
  263. 2630 IF I=0 THEN *字 ELSE GOSUB *ESCG:RETURN *S1
  264. 2640 *GL_A CLS:LOAD@ A$,(320-LX\2,240-LY\2):OSW=1
  265. 2650 EX=MX:EY=MY:MX=MOUSE(0):MY=MOUSE(1)
  266. 2660 IF OSW=1 THEN OSW=0:GOTO 2690
  267. 2670 IF EX=MX AND EY=MY THEN 2700
  268. 2680 LINE(EX,EY)-STEP(BX3,BY3),XOR,4,B
  269. 2690 LINE(MX,MY)-STEP(BX3,BY3),XOR,4,B
  270. 2700 IF MOUSE(2,0)=0 THEN 2650
  271. 2710 LINE(EX,EY)-STEP(BX3,BY3),XOR,4,B
  272. 2720 BX=EX:BY=EY:BX2=BX+BX3:BY2=BY+BY3
  273. 2730 GOSUB *ESCG:RETURN *S1
  274. 2740 *PLO LOAD@ A$,D
  275. 2750 FOR I=0 TO 15
  276. 2760 PUT@A(BX+I*BY4\16,BY)-(BX+(I+1)*BX4\16-1,BY2),D,,,,,2048*I:NEXT
  277. 2770 GOTO *字
  278. 2780 *ICNL B$="Q":GOSUB *ICN:I=0:IF A$="" THEN RETURN
  279. 2790 LOAD@ A$,D:IF ER>0 THEN RETURN
  280. 2800 LINE(BX,BY)-(BX2,BY2),PSET,7,BF
  281. 2810 FOR Y=0 TO 7:FOR X=0 TO 7
  282. 2820 PUT@A(640,0)-(640+31,15),D,,,,,128*(X+Y*8)+I*8192
  283. 2830 GET@A(640,0)-(640+31,15),B
  284. 2840 PUT@ (BX+X*32,BY+Y*32)-(BX+X*32+31,BY+Y*32+31),B,,0
  285. 2850 NEXT X,Y:IF I=0 THEN GOSUB *ESC:I=1:GOTO 2800
  286. 2860 RETURN
  287. 2870 *ICNS B$="P":GOSUB *ICN:I=0:IF A$="" THEN RETURN
  288. 2880 FOR Y=0 TO 7:FOR X=0 TO 7
  289. 2890 GET@ (BX+X*32,BY+Y*32)-(BX+X*32+31,BY+Y*32+31),B,0
  290. 2900 PUT@A(640,0)-(640+31,15),B
  291. 2910 GET@A(640,0)-(640+31,15),D,128*(X+Y*8)+I*8192
  292. 2920 NEXT X,Y:IF I=0 THEN GOSUB *ESC:I=1:GOTO 2880
  293. 2930 LINE(768,0)-(1023,511),PSET,0,BF
  294. 2940 PUT@A(768,0)-(1023,255),D
  295. 2950 ERASE D:DIM D(16383)
  296. 2960 GET@A(768,0)-(1023,255-MODE*64),D
  297. 2970 SAVE@ A$,D
  298. 2980 ERASE D:DIM D(32767):RETURN
  299. 2990 *ICN PRINT "DRIVE No.";:A$=INPUT$(1):PRINT
  300. 3000 IF A$<"0" OR (A$<"A" AND A$>"9") OR A$>B$ THEN A$="":RETURN
  301. 3010 A$=A$+":\TMENU.ICN":RETURN
  302. 3020 *DLOAD IF MODE=2 THEN RETURN
  303. 3030 LINE INPUT "LO PATTERN Bas FILE NAME",A$:IF A$="" OR A$=" " THEN *字
  304. 3040 OPEN "I",#1,A$:IF ER THEN RETURN
  305. 3050 GOSUB *ZA
  306. 3060 FOR Y=0 TO 127 STEP 16
  307. 3070 FOR X=0 TO 127 STEP 16:INPUT #1,A$
  308. 3080 FOR I=0 TO 63:INPUT #1,A$
  309. 3090 B(I)=CVI(CHR$(VAL(LEFT$(RIGHT$(A$,6),4)),VAL("&H"+RIGHT$(A$,2))))
  310. 3100 NEXT:PUT@A(EX+X,EY+Y)-(EX+X+15,EY+Y+15),B
  311. 3110 NEXT X,Y:CLOSE:GOTO *字
  312. 3120 '****************** ＭＯＵＳＥ **************************************
  313. 3130 *MOUSE M0=MOUSE(2,0):M1=MOUSE(2,1):MX=MOUSE(0):MY=MOUSE(1):I=0
  314. 3140 IF MUSW=0 THEN GOSUB *MUON
  315. 3150 IF MX>=BX AND MX<=BX2 AND MY>=BY AND MY<=BY2 THEN I=1
  316. 3160 IF I=1 AND MNO=2 THEN GOSUB *TEC
  317. 3170 IF M0+M1=0 THEN RETURN
  318. 3180 IF MX>=WX AND MX<=WX+XN AND MY>=WY AND MY<=WY+YN THEN *BOT
  319. 3190 IF I=1 THEN *TE
  320. 3200 IF MX>0 AND MX<128 THEN I=2
  321. 3210 IF MX>=XK AND MX<=XK2 AND MY>=YK AND MY<=YK2 THEN *MMM
  322. 3220 IF MX<=63 AND MY>=48 AND ((MY-48)\20)*2+MX\32<KI+1 THEN *MKINO
  323. 3230 IF I=2 AND MY>=376 AND MY<=392 THEN *MPEN
  324. 3240 IF I=2 AND MY>400 AND MY<434 THEN *MCHCOL
  325. 3250 IF MODE=2 AND MX>129 AND MX<146 AND MY>400 AND MY<434 THEN *MCHCOL2
  326. 3260 IF MX<BX-BX4/32 AND MX>BX-BX4/16 AND MY>=BY AND MY<BY2+1 THEN *MESC
  327. 3270 IF MY<20 AND MX>40 AND MX<CX(CX2(0)) THEN *MCM
  328. 3280 IF MX<BX AND MX>BX-BX4/16 AND MY<BY AND MY>BY-BY4/16 THEN I=3
  329. 3290 IF M0 AND I=3 THEN *ESC
  330. 3300 IF M1 AND I=3 THEN *ESC2
  331. 3310 IF MY<36 THEN *MKEY
  332. 3320 IF MX>600 AND MY>50 AND MX<634 AND MY<84 THEN *MPSPE
  333. 3330 IF MODE=2 AND MX>200 AND MY>400 AND MX<329 AND MY<433 THEN *MCOL
  334. 3340 RETURN
  335. 3350 *MCM I=1:EY=-1
  336. 3360 IF MX<CX(I)-1 THEN *MCM2
  337. 3370 IF I<=CX2(0) THEN I=I+1:EY=1:GOTO 3360
  338. 3380 RETURN
  339. 3390 *MCM2 GET@A(CX(I-1)-1,0)-(CX(I-1)+ASC(C$(I,0))*8+20,CX2(I)*17+24),B
  340. 3400 LINE(CX(I-1),0)-(CX(I)-1,19),XOR,7,BF
  341. 3410 LINE(CX(I-1)+2,2)-(CX(I)-3,17),XOR,7,BF
  342. 3420 LINE(CX(I-1)+1,22)-STEP(ASC(C$(I,0))*8+18.5!+EY/2,CX2(I)*17+2),PSET,0,BF
  343. 3430 LINE(CX(I-1)-1,20)-STEP(ASC(C$(I,0))*8+18.5!+EY/2,CX2(I)*17+2),PSET,0,BF,7
  344. 3440 FOR EX=1 TO CX2(I)
  345. 3450 SYMBOL(CX(I-1)+8+EY+(I MOD 2),5+EX*17),C$(I,EX),1,1,0:NEXT:EY=0
  346. 3460 MX=MOUSE(0):MY=MOUSE(1):M0=MOUSE(2,0):A$=INKEY$
  347. 3470 IF M0=0 AND A$="" THEN 3460
  348. 3480 IF M0=0 THEN 3520
  349. 3490 IF MY<20 AND MX>CX(I-1)-2 AND MX<CX(I)-1 THEN 3460
  350. 3500 IF MY>19 AND MY<19+17*CX2(I) AND MX>CX(I-1)-2 AND MX<CX(I-1)+ASC(C$(I,0))*8+17 THEN EY=(MY-3)\17:GOSUB 3700:GOTO 3590
  351. 3510 GOTO 3660
  352. 3520 IF A$<CHR$(28) AND A$<>CHR$(13) AND A$<>"" THEN 3590
  353. 3530 IF A$=CHR$(28) AND I<CX2(0) THEN GOSUB 3660:MX=CX(I):GOTO *MCM
  354. 3540 IF A$=CHR$(29) AND I>1 THEN GOSUB 3660:MX=CX(I-2):GOTO *MCM
  355. 3550 IF A$=CHR$(30) THEN GOSUB 3700:EY=EY-1:GOSUB 3700
  356. 3560 IF A$=CHR$(31) THEN GOSUB 3700:EY=EY+1:GOSUB 3700
  357. 3570 IF A$=CHR$(13) THEN 3590
  358. 3580 GOTO 3460
  359. 3590 GOSUB *MUSTP:GOSUB 3660
  360. 3600 ON I GOTO 3610,3620,3630,3640
  361. 3610 ON EY GOTO *GLOAD,*GSAVE,*GMSA,*GFSA,*GMFSA,*変換3,*ICNL,*ICNS,*MLOAD,*MSAVE
  362. 3620 ON EY GOTO *S回転,*SUD,*SLR,*反転
  363. 3630 ON EY GOTO *ANIM,*BUD,*BLR,*WQA,*WQU
  364. 3640 ON EY GOTO *変換,*印刷
  365. 3650 RETURN
  366. 3660 LINE(CX(I-1),0)-(CX(I)-1,19),XOR,7,BF
  367. 3670 LINE(CX(I-1)+2,2)-(CX(I)-3,17),XOR,7,BF
  368. 3680 PUT@A(CX(I-1)-1,0)-(CX(I-1)+ASC(C$(I,0))*8+20,CX2(I)*17+24),B
  369. 3690 RETURN
  370. 3700 IF EY<0 THEN EY=EY+CX2(I)+1
  371. 3710 IF EY>CX2(I) THEN EY=EY-CX2(I)-1
  372. 3720 Y=(I=1):IF EY THEN LINE(CX(I-1),4+EY*17)-STEP(ASC(C$(I,0))*8+17+Y,17),XOR,7,BF
  373. 3730 RETURN
  374. 3740 *MKEY X=MX\40+1:IF M0=0 THEN 3780
  375. 3750 ON X GOTO *MODES
  376. 3760 IF X=13 THEN *MAPM
  377. 3770 IF X=14 THEN *率
  378. 3780 IF X=15 THEN *CDPL
  379. 3790 IF X=16 AND M0 THEN *END
  380. 3800 RETURN
  381. 3810 *MCHCOL IF MODE=2 THEN 3860
  382. 3820 MP=((MX-1)\16)+((MY-400)\17)*8
  383. 3830 IF M0 THEN MP0=MP:GOSUB *MCHN
  384. 3840 IF M1 THEN MP1=MP:GOSUB *MCHN
  385. 3850 RETURN
  386. 3860 MYY=(MY-401)\11:I=M(MYY):M(MYY)=(MX-1)\16
  387. 3870 MP2=M(2)\2+M(1)*4+M(0)*32:X=131:Y=MP2:GOSUB *MCS
  388. 3880 IF I=M(MYY) THEN RETURN
  389. 3890 LINE(130,401)-(145,433),PSET,%MP2,BF
  390. 3900 LINE(16*I+2,402+MYY*11)-STEP(13,8),XOR,7,B
  391. 3910 LINE(16*M(MYY)+2,402+MYY*11)-STEP(13,8),XOR,7,B
  392. 3920 FOR Y=0 TO 2:EY=408+Y*11
  393. 3930 LINE(16*M(Y)+2,402+Y*11)-STEP(13,8),XOR,7,B
  394. 3940 LINE(1,EY)-(128,EY+3),AND,[-255*(Y=0),-255*(Y=1),-255*(Y=2)],BF
  395. 3950 LINE(1,EY)-(128,EY+3),OR,[-32*M(0)*(Y>0),-32*M(1)*(Y<>1),-32*M(2)*(Y<2)],BF
  396. 3960 LINE(16*M(Y)+2,EY-6)-STEP(13,8),XOR,7,B:NEXT:RETURN
  397. 3970 *MCHCOL2
  398. 3980 IF M0 THEN MP0=M(2)\2+M(1)*4+M(0)*32
  399. 3990 IF M1 THEN MP1=M(2)\2+M(1)*4+M(0)*32
  400. 4000 *MCHN
  401. 4010 IF M0 THEN X=150:Y=MP0:GOSUB *MCS
  402. 4020 IF M1 THEN X=170:Y=MP1:GOSUB *MCS
  403. 4030 RETURN
  404. 4040 *MCS LINE(X+1,401)-STEP(13,32),PSET,%Y,BF:SYMBOL(X,384),"■",1,1,0
  405. 4050 IF MODE=2 THEN PUT@A(X,435)-(X+15,450),V,,,,,V(V&-EV-1)*BX4*BY4\2+Y*128
  406. 4060 SYMBOL(X,384),RIGHT$(" "+HEX$(Y),2),1,1,7:RETURN
  407. 4070 *MCOL X=(MX-201)\4:Y=(MY-401)\4
  408. 4080 X=X+Y*32
  409. 4090 IF M0 THEN MP0=X ELSE MP1=X
  410. 4100 GOTO *MCHN
  411. 4110 *MMM
  412. 4120 ON MKNO GOSUB *MPOINT,*MLINE,*MLINE,*MLINE,*MMARU,*MMARU,*MARU1,*MARU1,*TEN,*TEN,*MCOPY,*MCOPY,*MPAINT
  413. 4130 GOTO *MOUSE
  414. 4140 *R GOSUB *W:GOTO *拡大
  415. 4150 *MPOINT
  416. 4160 X=(MX-XK)\XB:EX=XB*X+XK:Y=(MY-YK)\YB:EY=YB*Y+YK
  417. 4170 IF M0 THEN Z=MP0 ELSE Z=MP1
  418. 4180 IF V(V&-V)=0 THEN LINE(EX,EY)-STEP(XB2,YB2),PSET,%Z,BF:GOTO 4200
  419. 4190 PUT@A(EX,EY)-(EX+15,EY+15),V,,XB/16,YB/16,,V(V&-EV-1)*BX4*BY4\2+Z*128
  420. 4200 PSET(WX+X,WY+Y),%Z
  421. 4210 M0=MOUSE(2,0):M1=MOUSE(2,1):MX=MOUSE(0):MY=MOUSE(1)
  422. 4220 IF MX>=XK AND MY>=YK AND MX<=XK2 AND MY<=YK2 AND M0+M1 THEN 4150
  423. 4230 RETURN
  424. 4240 *MLINE EX=MX:EY=MY:GOSUB *MI
  425. 4250 X=EX:Y=EY:MX=MOUSE(0):MY=MOUSE(1)
  426. 4260 IF MKNO=2 THEN MX20=FNMX(EX)+XB/2:MY20=FNMY(EY)+YB/2:MX21=FNMX(MX)+XB/2:MY21=FNMY(MY)+YB/2:LINE(MX20,MY20)-(MX21,MY21),XOR,7:LINE(MX20,MY20)-(MX21,MY21),XOR,7:GOTO 4300
  427. 4270 IF MX<X THEN SWAP X,MX
  428. 4280 IF MY<Y THEN SWAP Y,MY
  429. 4290 MX20=FNMX(X):MY20=FNMY(Y):MX21=FNMX(MX)+XB:MY21=FNMY(MY)+YB:LINE(MX20,MY20)-(MX21,MY21),XOR,7,B:LINE(MX20,MY20)-(MX21,MY21),XOR,7,B
  430. 4300 IF MOUSE(2,0) OR MOUSE(2,1) THEN 4250
  431. 4310 GOSUB *MO
  432. 4320 MP2=-MP0*M0-MP1*M1
  433. 4330 IF MKNO=2 THEN LINE(FNSX(EX),FNSY(EY))-(FNSX(MX),FNSY(MY)),PSET,%MP2
  434. 4340 IF MKNO=3 THEN LINE(FNSX(X),FNSY(Y))-(FNSX(MX),FNSY(MY)),PSET,%MP2,B
  435. 4350 IF MKNO=4 THEN LINE(FNSX(X),FNSY(Y))-(FNSX(MX),FNSY(MY)),PSET,%MP2,BF
  436. 4360 GOTO *R
  437. 4370 *MMARU EX=MX:EY=MY:GOSUB *MI:GOSUB *WI2
  438. 4380 MX=MOUSE(0):MY=MOUSE(1):MR=SQR((MX-EX)*(MX-EX)+(MY-EY)*(MY-EY)*XB/YB)
  439. 4390 CIRCLE(EX,EY),MR,7,YB/XB,,,N,XOR:CIRCLE(EX,EY),MR,7,YB/XB,,,N,XOR
  440. 4400 IF MOUSE(2,0) OR MOUSE(2,1) THEN 4380
  441. 4410 GOSUB *MO:GOSUB *W
  442. 4420 MP2=-MP0*M0-MP1*M1:GOSUB *WI
  443. 4430 CIRCLE(FNSX(EX),FNSY(EY)),MR/XB,%MP2,1,,,N,PSET
  444. 4440 IF MKNO=6 THEN CIRCLE(FNSX(EX),FNSY(EY)),MR/XB,%MP2,1,,,F,PSET
  445. 4450 GOTO *R
  446. 4460 *MARU1 EX=MX:EY=MY:GOSUB *MI:GOSUB *WI2
  447. 4470 MX=MOUSE(0):MY=MOUSE(1)
  448. 4480 MR=ABS(MX-EX):IF MR<1 THEN 4470
  449. 4490 GX=ABS((MY-EY)/MR):IF GX<.01! THEN 4470
  450. 4500 CIRCLE(EX,EY),MR,7,GX,,,N,XOR:CIRCLE(EX,EY),MR,7,GX,,,N,XOR
  451. 4510 IF MOUSE(2,0) OR MOUSE(2,1) THEN 4470
  452. 4520 GOSUB *MO:GOSUB *W
  453. 4530 MP2=-MP0*M0-MP1*M1:GOSUB *WI
  454. 4540 CIRCLE(FNSX(EX),FNSY(EY)),MR/XB,%MP2,GX*XB/YB,,,N,PSET
  455. 4550 IF MKNO=8 THEN CIRCLE(FNSX(EX),FNSY(EY)),MR/XB,%MP2,GX*XB/YB,,,F,PSET
  456. 4560 GOTO *R
  457. 4570 *TEN GOSUB *MI
  458. 4580 EX=MX:EY=MY:X=MOUSE(0):Y=MOUSE(1)
  459. 4590 IF X<EX THEN SWAP X,EX
  460. 4600 IF Y<EY THEN SWAP Y,EY
  461. 4610 LINE(FNMX(EX),FNMY(EY))-(FNMX(X)+XB,FNMY(Y)+YB),XOR,7,B
  462. 4620 LINE(FNMX(EX),FNMY(EY))-(FNMX(X)+XB,FNMY(Y)+YB),XOR,7,B
  463. 4630 IF MOUSE(2,0) THEN 4580
  464. 4640 X=FNSX(X):Y=FNSY(Y)
  465. 4650 EX=FNSX(EX):EY=FNSY(EY)
  466. 4660 GOSUB *MO
  467. 4670 IF MKNO=9 THEN *UD ELSE *LR
  468. 4680 *MCOPY GOSUB *MUSTP:GOSUB *MI:X=MX:Y=MY
  469. 4690 MX=MOUSE(0):MY=MOUSE(1)
  470. 4700 EX=X:M0=MX:IF EX>M0 THEN SWAP EX,M0
  471. 4710 EY=Y:M1=MY:IF EY>M1 THEN SWAP EY,M1
  472. 4720 LINE(FNMX(EX),FNMY(EY))-(FNMX(M0)+XB,FNMY(M1)+YB),XOR,7,B
  473. 4730 LINE(FNMX(EX),FNMY(EY))-(FNMX(M0)+XB,FNMY(M1)+YB),XOR,7,B
  474. 4740 IF MOUSE(2,0) THEN 4690
  475. 4750 LINE(FNMX(EX),FNMY(EY))-(FNMX(M0)+XB,FNMY(M1)+YB),XOR,7,B
  476. 4760 MX20=FNSX(EX):MY20=FNSY(EY):MX21=FNSX(M0):MY21=FNSY(M1)
  477. 4770 LINE(FNMX(EX),FNMY(EY))-(FNMX(M0)+XB,FNMY(M1)+YB),XOR,7,B
  478. 4780 MOUSE 1,M0,M1:MUSW=0
  479. 4790 GET@A(MX20,MY20)-(MX21,MY21),B
  480. 4800 MX5=ABS(FNMX(M0)-FNMX(EX)):MY5=ABS(FNMY(M1)-FNMY(EY))
  481. 4810 MOUSE 4,XK+MX5,YK+MY5,XK2,YK2
  482. 4820 MX=MOUSE(0):MY=MOUSE(1)
  483. 4830 EX=MX-MX5:M0=MX:EY=MY-MY5:M1=MY
  484. 4840 MX1=FNMX(EX):MY1=FNMY(EY):MX11=FNMX(M0)+XB:MY11=FNMY(M1)+YB
  485. 4850 LINE(MX1,MY1)-(MX11,MY11),XOR,4,B
  486. 4860 LINE(MX1,MY1)-(MX11,MY11),XOR,4,B
  487. 4870 IF MOUSE(2,0)=0 AND MOUSE(2,1)=0 THEN 4820
  488. 4880 LINE(MX1,MY1)-(MX11,MY11),XOR,4,B
  489. 4890 IF MOUSE(2,1) THEN 4940
  490. 4900 GOSUB *MO
  491. 4910 X=FNSX(MX1+1):Y=FNSY(MY1)
  492. 4920 IF MKNO=12 THEN LINE(MX20,MY20)-(MX21,MY21),PSET,0,BF
  493. 4930 IF MOUSE(2,0) THEN PUT@A(X,Y)-(X-MX20+MX21,Y-MY20+MY21),B
  494. 4940 GOSUB *MD:GOSUB *MUON:GOSUB *MO:GOTO *R
  495. 4950 *MPAINT X=FNSX(MX):Y=FNSY(MY):GOSUB *WI
  496. 4960 PAINT@(X,Y),%-M0*MP0-M1*MP1*(M0+1):GOSUB *W:GOTO 4140
  497. 4970 *MI MUF=1:MOUSE 4,XK,YK,XK2,YK2:RETURN
  498. 4980 *MMI MUF=2:MOUSE 4,BX,BY,BX2,BY2:RETURN
  499. 4990 *MO MUF=0:MOUSE 4,0,0,639,479:RETURN
  500. 5000 *WI WINDOW(WX,WY)-(WX+XN,WY+YN):VIEW(WX,WY)-(WX+XN,WY+YN):RETURN
  501. 5010 *WI2 WINDOW(XK,YK)-(XK2,YK2):VIEW(XK,YK)-(XK2,YK2):RETURN
  502. 5020 *WI3 WINDOW(BX,BY)-(BX2,BY2):VIEW(BX,BY)-(BX2,BY2):RETURN
  503. 5030 *W WINDOW(0,0)-(1023,511):VIEW(0,0)-(1023,511):RETURN
  504. 5040 *NEKO GOSUB *ESCG:Z=(BY+BY2)/2:GOSUB *MMI
  505. 5050 IF V2=-1 THEN V2=V*BY4*(MODE+2)\8
  506. 5060 MOUSE 1,(BX+BX2)/2,Z,0
  507. 5070 V2=V2+(MOUSE(1)-Z)/2:M0=MOUSE(2,0)
  508. 5080 IF V2<0 THEN V2=0
  509. 5090 IF V2>(V&\BX4)-BY4/2-(MODE=0)*BY4/4 THEN V2=(V&\BX4)-BY4/2-(MODE=0)*BY4/4
  510. 5100 PUT@A(BX,BY)-(BX2,BY2),V,,,,,V2*BX4
  511. 5110 IF M0 THEN 5070
  512. 5120 GOSUB *MUON:GOSUB *MO:RETURN
  513. 5130 *TE IF V(V&-V)=1 THEN *MMA
  514. 5140 ON MNO GOTO 5150,5150,*MPEN2,*MGET,*MPUT,*楕円,*TILCH,*NEKO,*FANT
  515. 5150 IF M0 THEN GET@A(WX,WY)-(WX+XN,WY+YN),B:PUT@A(EX,EY)-(EX+XN,EY+YN),B
  516. 5160 IF M1 THEN GET@A(EX,EY)-(EX+XN,EY+YN),B:PUT@A(WX,WY)-(WX+XN,WY+YN),B:GOSUB *拡大
  517. 5170 GOTO *MOUSE
  518. 5180 *MPEN CIRCLE(MPEN*16+8,384),MPEN,7,1,,,F,PSET:MPEN=(MX-1)\16
  519. 5190 *MPE CIRCLE(MPEN*16+8,384),MPEN,2,1,,,F,PSET
  520. 5200 GET@A(MPEN*16-7,369)-(MPEN*16+24,400),B
  521. 5210 PUT@A(0,480)-(31,511),B
  522. 5220 GET@(0,480)-(31,511),P,2
  523. 5230 LINE(601,51)-(632,82),PSET,0,BF
  524. 5240 PUT@(601,51)-(632,82),P,PSET,7:RETURN
  525. 5250 *MPSPE GET@(WX,WY)-(WX+31,WY+31),P
  526. 5260 LINE(601,51)-(632,82),PSET,0,BF
  527. 5270 PUT@(601,51)-(632,82),P,,7:RETURN
  528. 5280 *MPEN2 GOSUB *WI3:GOSUB *PEI
  529. 5290 M0=MOUSE(2,0):M1=MOUSE(2,1):MP2=-MP0*M0-MP1*M1*(M0+1)
  530. 5300 IF M0=0 AND M1=0 THEN 5330
  531. 5310 X=MX:Y=MY:MX=MOUSE(0):MY=MOUSE(1):LINE(X,Y)-(MX,MY),PSET,%MP2
  532. 5320 IF MX>=BX AND MY>=BY AND M0 OR M1 THEN 5290
  533. 5330 GOSUB *W:GOTO *MOUSE
  534. 5340 *楕円 GOSUB *WI3:GOSUB *MMI:GOSUB *PEI:GET@A(BX,BY)-(BX2,BY2),B
  535. 5350 X=MOUSE(4,0):Y=MOUSE(5,0):PSET(X,Y),7,XOR
  536. 5360 IF MOUSE(2,0) THEN 5360
  537. 5370 IF MOUSE(2,0)=0 THEN 5370
  538. 5380 EX=MOUSE(4,0):EY=MOUSE(5,0):PSET(EX,EY),7,XOR
  539. 5390 IF MOUSE(2,0) THEN 5390
  540. 5400 IF MOUSE(2,0)=0 THEN 5400
  541. 5410 GX3=MOUSE(4,0):GY3=MOUSE(5,0)
  542. 5420 IF MOUSE(2,0) THEN 5420
  543. 5430 PSET(X,Y),7,XOR:PSET(EX,EY),7,XOR
  544. 5440 GOSUB *MUSTP
  545. 5450 GSQR=SQR((EX-X)^2+(EY-Y)^2)
  546. 5460 IF GSQR=0 THEN PSET(X,Y),%MP0:GOTO 5730
  547. 5470 GCOS=(EX-X)/GSQR:GSIN=(EY-Y)/GSQR
  548. 5480 GX4=(X+EX)/2:GY4=(Y+EY)/2
  549. 5490 X3=GX3-GX4:Y3=GY3-GY4
  550. 5500 EX2=(EX-GX4)*GCOS+(EY-GY4)*GSIN
  551. 5510 EX3=X3*GCOS+Y3*GSIN:EY3=-X3*GSIN+Y3*GCOS
  552. 5520 GA=ABS(EX2):GL=EX3:GM=EY3:IF GA=GL THEN ER=11:GOTO 5550
  553. 5530 GB=ABS(GA*GM/SQR(ABS(GA^2-GL^2)))
  554. 5540 GAA=(GSIN/GA)^2+(GCOS/GB)^2
  555. 5550 IF ER=11 THEN ER=0:LINE(X,Y)-(EX,EY),PSET,%MP0:GOTO 5730
  556. 5560 GBB=2*GSIN*GCOS/GA^2-2*GSIN*GCOS/GB^2
  557. 5570 GCC=(GCOS/GA)^2+(GSIN/GB)^2
  558. 5580 GX=0:GYY=0
  559. 5590 GV=(GBB*GX)^2-4*GAA*(GCC*GX*GX-1)
  560. 5600 IF GV<0 THEN 5650 ELSE GW=SQR(GV)
  561. 5610 PSET(GX+GX4,(-GBB*GX+GW)/2/GAA+GY4),%MP0
  562. 5620 PSET(GX+GX4,(-GBB*GX-GW)/2/GAA+GY4),%MP0
  563. 5630 PSET(-GX+GX4,(GBB*GX+GW)/2/GAA+GY4),%MP0
  564. 5640 PSET(-GX+GX4,(GBB*GX-GW)/2/GAA+GY4),%MP0
  565. 5650 GVV=(GBB*GYY)^2-4*GCC*(GAA*GYY^2-1)
  566. 5660 IF GVV<0 THEN 5710 ELSE GW=SQR(GVV)
  567. 5670 PSET((-GBB*GYY+GW)/2/GCC+GX4,GYY+GY4),%MP0
  568. 5680 PSET((-GBB*GYY-GW)/2/GCC+GX4,GYY+GY4),%MP0
  569. 5690 PSET((GBB*GYY+GW)/2/GCC+GX4,-GYY+GY4),%MP0
  570. 5700 PSET((GBB*GYY-GW)/2/GCC+GX4,-GYY+GY4),%MP0
  571. 5710 GYY=GYY+1:GX=GX+1
  572. 5720 IF GV>=0 OR GVV>=0 THEN 5590
  573. 5730 GOSUB *MO:GOSUB *W:GOSUB *MUON:GOTO *MOUSE
  574. 5740 *MGET GOSUB *MMI:EX=MX:EY=MY
  575. 5750 MX=MOUSE(0):MY=MOUSE(1)
  576. 5760 GOSUB *MGP:GOSUB *MGP
  577. 5770 IF MOUSE(2,0) THEN 5750
  578. 5780 GOSUB *MGP
  579. 5790 GOSUB *MD2
  580. 5800 GOSUB *MGP
  581. 5810 IF MOUSE(2,1) THEN 5850
  582. 5820 GET@A(EX,EY)-(MX,MY),VZ
  583. 5830 MX55=ABS(MX-EX)+1:MY55=ABS(MY-EY)+1
  584. 5840 IF MOUSE(2,0) THEN 5840
  585. 5850 GOSUB *MO:GOTO *MOUSE
  586. 5860 *MGP LINE(EX,EY)-(MX,MY),XOR,4,B:RETURN
  587. 5870 *MPUT IF MOUSE(2,1) THEN *MRE
  588. 5880 GOSUB *MMI:EX=MX:EY=MY
  589. 5890 MX=MX+MX55-1:IF MX>BX2 THEN MX=BX2
  590. 5900 MY=MY+MY55-1:IF MY>BY2 THEN MY=BY2
  591. 5910 MOUSE 1,MX,MY,1:MUSW=1
  592. 5920 MX=MOUSE(0):MY=MOUSE(1)
  593. 5930 GOSUB *MGP:GOSUB *MGP
  594. 5940 IF MOUSE(2,0) THEN 5920
  595. 5950 IF EX>MX THEN SWAP EX,MX
  596. 5960 IF EY>MY THEN SWAP EY,MY
  597. 5970 GOSUB *MGP
  598. 5980 GOSUB *MD2
  599. 5990 GOSUB *MGP
  600. 6000 IF MOUSE(2,1) THEN GOSUB *MRE:GOTO *MOUSE
  601. 6010 MX=ABS(MX-EX)+1:MY=ABS(MY-EY)+1
  602. 6020 PUT@A(EX,EY)-(EX+MX55-1,EY+MY55-1),VZ,,MX/MX55,MY/MY55
  603. 6030 IF MOUSE(2,0) THEN 6030
  604. 6040 MOUSE 1,EX,EY,1:MUSW=1
  605. 6050 GOSUB *MO:GOTO *MOUSE
  606. 6060 *MKINO I=((MY-48)\20)*2+MX\32+1
  607. 6070 IF A(I-1)=0 THEN 6130
  608. 6080 IF A(I-1)=2 THEN 6120
  609. 6090 Z=MNO+13:GOSUB *MKCH:MNO=I-13
  610. 6100 IF I=15 AND M1 THEN GOSUB *TEB
  611. 6110 GOTO 6140
  612. 6120 IF I=14 THEN *SPOIT
  613. 6130 Z=MKNO:GOSUB *MKCH:MKNO=I
  614. 6140 *MJ Z=I:GOSUB *MKCH:GOTO *MOUSE
  615. 6150 *MKCH X=((Z-1) MOD 2)*32+1:Y=((Z+1)\2)*20+29:LINE(X,Y)-STEP(30,18),XOR,7,BF:RETURN
  616. 6160 *MODES GOSUB *ESCG:GOSUB *EDG:MODE=2-MODE:GOSUB *MUSTP:RETURN *S1
  617. 6170 *TEB SYMBOL(16,201),RIGHT$(STR$(EG),2),1,.5!,7:IF EG=1 THEN EG=128
  618. 6180 EG=EG/2:SYMBOL(16,201),RIGHT$(STR$(EG),2),1,.5!,0:GOTO *MRE
  619. 6190 *TEC
  620. 6200 EX=BX+((MOUSE(0)-BX-(XN2-EG)/2)\(BX4\(256/EG)))*(BX4\(256/EG))
  621. 6210 EY=BY+((MOUSE(1)-BY-(YN2-EG)/2)\(BY4\(256/EG)))*(BY4\(256/EG))
  622. 6220 IF EX>BX2-XN THEN EX=BX2-XN
  623. 6230 IF EY>BY2-YN THEN EY=BY2-YN
  624. 6240 IF EX<BX THEN EX=BX
  625. 6250 IF EY<BY THEN EY=BY
  626. 6260 LINE(EX,EY)-STEP(XN,YN),XOR,7,B
  627. 6270 LINE(EX,EY)-STEP(XN,YN),XOR,7,B
  628. 6280 RETURN
  629. 6290 *MRE GOSUB *W:GOSUB *MO
  630. 6300 *MD IF MOUSE(2,0) OR MOUSE(2,1) THEN *MD ELSE RETURN
  631. 6310 *MD2 IF MOUSE(2,0) OR MOUSE(2,1) THEN RETURN ELSE *MD2
  632. 6320 *BOT IF L=5 THEN 3190
  633. 6330 X=MX-WX:Y=MOUSE(1)-WY:GOSUB *EDG:Z=6
  634. 6340 LINE(MX-X,MY-Y)-STEP(XN,YN),XOR,Z,B
  635. 6350 LINE(MX-X,MY-Y)-STEP(XN,YN),XOR,Z,B
  636. 6360 IF MOUSE(2,0) THEN Z=6:MX=MOUSE(0):MY=MOUSE(1):GOTO 6340
  637. 6370 IF MOUSE(2,1) THEN Z=1:MX=MOUSE(0):MY=MOUSE(1):GOTO 6340
  638. 6380 WX=MX-X:WY=MY-Y
  639. 6390 IF Z=6 THEN GOSUB *EDP
  640. 6400 GOTO *MOUSE
  641. 6410 *SPOIT Z=MNO+13:GOSUB *MKCH:Z=MKNO:GOSUB *MKCH:Z=I:GOSUB *MKCH
  642. 6420 IF MOUSE(2,0) OR MOUSE(2,1) THEN 6420
  643. 6430 M0=MOUSE(2,0):M1=MOUSE(2,1):IF M0 OR M1 ELSE 6430
  644. 6440 B(0)=0:GET@A(MOUSE(0),MOUSE(1))-(MOUSE(0),MOUSE(1)),B
  645. 6450 IF M0 THEN MP0=B(0) ELSE MP1=B(0)
  646. 6460 GOSUB *MCHN
  647. 6470 Z=MNO+13:GOSUB *MKCH:Z=MKNO:GOSUB *MKCH
  648. 6480 GOSUB *MD:GOTO *MJ
  649. 6490 *TILCH GET@A(BX,BY)-(BX2,BY2),B
  650. 6500 LINE(BX,BY)-(BX2,BY2),PSET,%MP0,BF
  651. 6510 PUT@A(BX,BY)-(BX2,BY2),B,MATTE,,,%MP1:GOTO *MUON
  652. 6520 *PEI IF MPEN=0 THEN DEF PEN 0,1:RETURN
  653. 6530 DEF PEN 1,P:RETURN
  654. 6540 *MESC GOSUB *ESCG:V=EV*(MY-BY)\256:V2=-1:GOTO *ESCP
  655. 6550 *CDPL CDSTAT B:IF ER THEN ER=0:RETURN
  656. 6560 CDINF D:M0=-M0-M1*2
  657. 6570 IF D(1)=2 THEN 6640
  658. 6580 ON M0 GOTO 6610,6590,6640 
  659. 6590 IF B(5)<D(5) AND B(1)=1 THEN CD PLAY B(5)+1,D(5) ELSE CD PLAY
  660. 6600 RETURN
  661. 6610 IF B(1)=1 THEN CD PAUSE:GOTO 6630
  662. 6620 IF B(1)=0 THEN CD CONT:CDSTAT B:IF B(1)=0 THEN CD PLAY
  663. 6630 IF MOUSE(2,0) THEN 6630 ELSE RETURN
  664. 6640 CD STOP:RETURN
  665. 6650 '********************************************************************
  666. 6660 *反転 LINE(WX,WY)-STEP(XN,YN),XOR,7,BF:GOTO *拡大
  667. 6670 *B反転 LINE(BX,BY)-(BX2,BY2),XOR,7,BF:RETURN
  668. 6680 *WQU X=1:GOTO *WQ
  669. 6690 *WQA X=0
  670. 6700 *WQ Y=(1-X)*BY4\2
  671. 6710 GET@A(BX,BY)-(BX2,BY2),B
  672. 6720 GET@A(BX+X,BY+1-X)-(BX2+X,BY2+1-X),D
  673. 6730 PUT@A(BX,BY)-(BX2,BY2),B,,1/(1+X),1/(2-X)
  674. 6740 PUT@A(BX+X*BX4\2,BY+Y)-(BX2+(BX4\2)*X,BY2+Y),D,,1/(1+X),1/(2-X)
  675. 6750 RETURN
  676. 6760 *ANIM GOSUB *ESCG
  677. 6770 FOR I=0 TO EV-1
  678. 6780 PUT@A(BX,BY)-(BX2,BY2),V,,,,,I*BX4*BY4/(4-MODE)
  679. 6790 WAIT 2:NEXT:A$=INKEY$:IF A$="J" THEN GOTO 6770
  680. 6800 GOTO *ESCP
  681. 6810 *SUD X=WX:Y=WY:EX=X+XN:EY=Y+YN:GOTO *UD
  682. 6820 *BUD X=BX:Y=BY:EX=BX2:EY=BY2
  683. 6830 *UD IF EY<Y THEN SWAP EY,Y
  684. 6840 Z=EY-Y:FOR I=0 TO Z STEP 2:I&=I-((Z MOD 2)=0)*(I>Z\2)
  685. 6850 GET@A(X,Y+I&)-(EX,Y+I&),B:GET@A(X,EY-I&)-(EX,EY-I&),D
  686. 6860 PUT@A(X,Y+I&)-(EX,Y+I&),D:PUT@A(X,EY-I&)-(EX,EY-I&),B
  687. 6870 NEXT:GOTO *拡大
  688. 6880 *SLR X=WX:Y=WY:EX=X+XN:EY=Y+YN:GOTO *LR
  689. 6890 *BLR X=BX:Y=BY:EX=BX2:EY=BY2
  690. 6900 *LR IF EX<X THEN SWAP EX,X
  691. 6910 Z=EX-X:FOR I=0 TO Z STEP 2:I&=I-((Z MOD 2)=0)*(I>Z\2)
  692. 6920 GET@A(X+I&,Y)-(X+I&,EY),B:GET@A(EX-I&,Y)-(EX-I&,EY),D
  693. 6930 PUT@A(X+I&,Y)-(X+I&,EY),D:PUT@A(EX-I&,Y)-(EX-I&,EY),B
  694. 6940 NEXT:GOTO *拡大
  695. 6950 *CLS FOR I=0 TO XB*XN2-1 STEP 2
  696. 6960 LINE(XK+I,YK+I)-(XK+XB*XN2-I-1,YK+YB*YN2-I-1),PSET,0,B
  697. 6970 LINE(WX+I\XB,WY+I\YB)-(WX+XN2-I\XB-1,WY+YN2-I\YB-1),PSET,0,B
  698. 6980 NEXT:RETURN
  699. 6990 *BCLS FOR I=0 TO BY3 STEP 2
  700. 7000 LINE(BX,BY+I)-(BX2,BY+I),PSET,0
  701. 7010 LINE(BX,BY2-I)-(BX2,BY2-I),PSET,0
  702. 7020 NEXT:RETURN
  703. 7030 *SROLL EX=WX:EY=WY:X=XN:Y=YN:GOTO *ROLL
  704. 7040 *BROLL EX=BX:EY=BY:X=BX3:Y=BY3
  705. 7050 *ROLL A$=INKEY$:IF A$="" AND MOUSE(2,0)+MOUSE(2,1)=0 THEN 7050
  706. 7060 IF INSTR("2468"+CHR$(28,29,30,31),A$)=0 OR MOUSE(2,0)+MOUSE(2,1) THEN *拡大
  707. 7070 I=-(A$=CHR$(28))-(A$="6")*16-(A$=CHR$(29))*X-(A$="4")*(X-15)
  708. 7080 Z=-(A$=CHR$(30))-(A$="8")*16-(A$=CHR$(31))*Y-(A$="2")*(Y-15)
  709. 7090 GET@A(EX,EY+Z)-(EX+X-I,EY+Y),B
  710. 7100 GET@A(EX-(I>0)*(X+1)-I,EY)-(EX+X,EY+Y+(Z>0)*(Y+1)+Z),D
  711. 7110 PUT@A(EX,EY-(Z>0)*(Y+1)-Z)-(EX+X+(I>0)*(X+1)+I,EY+Y),D
  712. 7120 PUT@A(EX+I,EY)-(EX+X,EY+Y-Z),B
  713. 7130 GOTO 7050
  714. 7140 *S回転 EX=WX:EY=WY:X=WX+XN:Y=WY+YN:Z=XN:YY=YN:I=0:GOTO *回転
  715. 7150 *B回転 EX=BX:EY=BY:X=BX2:Y=BY2:Z=BX3:YY=BY3:I=1
  716. 7160 *回転 IF MODE>0 THEN 7240
  717. 7170 FOR I=0 TO Z:GET@A(X-I,EY)-(X-I,Y),B
  718. 7180 PUT@A(3,480)-(YY+3,487),B:GET@A(0,480)-(YY,487),B
  719. 7190 PUT@A(640,I)-(647+YY*8,I),B,,.125!,Z/YY
  720. 7200 NEXT
  721. 7210 GET@A(640,0)-(640+YY,Z),B
  722. 7220 PUT@A(EX,EY)-(EX+YY,EY+Z),B,,Z/YY,YY/Z
  723. 7230 GOTO 7260
  724. 7240 FOR I=EX TO X:GET@A(I,EY)-(I,Y),B,(Z+EX-I)*(YY+1)\2:NEXT
  725. 7250 PUT@A(EX,EY)-(X,Y),B
  726. 7260 IF I=1 THEN RETURN ELSE *拡大
  727. 7270 *変換 GOSUB *ESCG
  728. 7280 IF MODE=2 THEN *取り込み
  729. 7290 *変換1 SCREEN@2:CLS:GET@A(0,0)-(BX3,BY3),D
  730. 7300 FOR I=1 TO 3:SCREEN@0:GOSUB *ESCP
  731. 7310 GET@(BX,BY)-(BX2,BY2),B,I-(I=3),3-(I=3)*2,6+(I=1),7
  732. 7320 SCREEN@2:PUT@A(BX,BY)-(BX2,BY2),D
  733. 7330 PUT@(BX,BY)-(BX2,BY2),B,OR,I-(I=3)
  734. 7340 GET@A(BX,BY)-(BX2,BY2),D
  735. 7350 SCREEN@0:GOSUB *ESCP
  736. 7360 GET@(BX,BY)-(BX2,BY2),B,%I-(I=3),%3-(I=3)*2,%6+(I=1),%7
  737. 7370 SCREEN@2:PUT@A(BX,BY)-(BX2,BY2),D
  738. 7380 PUT@(BX,BY)-(BX2,BY2),B,OR,[-(I=3)*127,-(I=2)*127,-(I=1)*127]
  739. 7390 GET@A(BX,BY)-(BX2,BY2),D:NEXT I
  740. 7400 SCREEN@0:GOSUB *ESCP
  741. 7410 GET@(BX,BY)-(BX2,BY2),B,%8
  742. 7420 SCREEN@2:PUT@A(BX,BY)-(BX2,BY2),D
  743. 7430 PUT@(BX,BY)-(BX2,BY2),B,OR,[63,63,63]
  744. 7440 GET@A(BX,BY)-(BX2,BY2),D
  745. 7450 MODE=2:GOSUB *ESCG:RETURN *S1
  746. 7460 *取り込み SCREEN@1:SIMPOSE ON
  747. 7470 SINPUT:IF MOUSE(2,1) THEN RETURN *S1
  748. 7480 LINE(0,0)-(159-BX4\2,239),PSET,[0,0,0,1],BF
  749. 7490 LINE(161-BX4\2+BX3,0)-(319,239),PSET,[0,0,0,1],BF
  750. 7500 GOSUB *MD
  751. 7510 A$=INKEY$
  752. 7520 IF A$=CHR$(13) OR MOUSE(2,1) THEN GOSUB *MD:GOTO 7470
  753. 7530 IF A$="" AND MOUSE(2,0)=0 THEN 7510
  754. 7540 *変換2 GET@A(160-BX4\2,0)-(160-BX4\2+BX3,BY3),B:SCREEN@2:GOSUB *ESCG
  755. 7550 FOR T=0 TO 2:FOR I=5-(T=2) TO 7:A=2^I:X=-A*(T=0):Y=-A*(T=1)
  756. 7560 Z=-A*(T=2):SCREEN@1:VIEW(0,0)-(255,255):WINDOW(0,0)-(255,255)
  757. 7570 PUT@A(0,0)-(255,255),B:LINE(0,0)-(255,255),AND,[X,Y,Z],BF
  758. 7580 GET@(0,0)-(255,255),D:SCREEN@2:GOSUB *ESCP
  759. 7590 PUT@(BX,BY)-(BX2,BY2),D,OR,[X,Y,Z]:GOSUB *ESCG:NEXT I,T:RETURN *S1
  760. 7600 *変換3 GOSUB *EDG:GOSUB *ESCG:SCREEN@1:CLS:GET@A(0,0)-(255,255),B
  761. 7610 FOR T=0 TO 2:FOR I=5-(T=2) TO 7:A=2^I+31
  762. 7620 X=-A*(T=0):Y=-A*(T=1):Z=-(A+32)*(T=2):SCREEN@MODE:GOSUB *ESCP
  763. 7630 LINE(BX,BY)-(BX2,BY2),AND,[X,Y,Z],BF:GET@(BX,BY)-(BX2,BY2),D
  764. 7640 SCREEN@1:VIEW(0,0)-(BX3,BY3):PUT@A(0,0)-(255,255),B
  765. 7650 PUT@(0,0)-(255,255),D,OR,[X,Y,Z]:GET@A(0,0)-(255,255),B:NEXT I,T
  766. 7660 LINE INPUT "SAVE FILE NAME ",A$:IF A$="" OR A$=" " THEN RETURN *S1
  767. 7670 IF INSTR(A$,".")=0 THEN A$=A$+".TIF"
  768. 7680 IF RIGHT$(A$,3)="PTN" THEN *PSA3
  769. 7690 SAVE@ A$,(0,0)-(BX3,BY3):RETURN *S1
  770. 7700 *PSA3 FOR I=0 TO 15
  771. 7710 GET@A(I*BX4\16,0)-((I+1)*BX4\16-1,BY3),B,I*4096
  772. 7720 NEXT:SAVE@ A$,B:RETURN *S1
  773. 7730 *B拡大 GOSUB *ZA
  774. 7740 GET@A(EX,EY)-(EX+BX3\2,EY+BY3\2),B
  775. 7750 PUT@A(BX,BY)-(BX+BX3\2,BY+BY3\2),B,,2,2
  776. 7760 GOTO *字
  777. 7770 *率 EGX(L)=WX:EGY(L)=WY:GOSUB *EDG
  778. 7780 L=L+1+(L=5)*6-(V(V&-V)>0)*(L>1)*(L+1):XN2=8*2^L:YN2=8*2^L
  779. 7790 GOSUB *MODE:GOSUB *EDP:GOTO *拡大
  780. 7800 *EDG IF L<5 THEN GET@A(WX,WY)-(WX+XN,WY+YN),VA,EM(L)
  781. 7810 RETURN
  782. 7820 *EDP IF L<5 THEN PUT@A(WX,WY)-(WX+XN,WY+YN),VA,,,,,EM(L)
  783. 7830 RETURN
  784. 7840 *面積 GET@A(BX,BY)-(BX2,BY2),B
  785. 7850 PUT@A(640,0)-(640+BX3\2,BY3*2+1),B,,2
  786. 7860 FOR I=641 TO 640+BX3 STEP 2
  787. 7870 LINE(I,0)-(I,511),PSET,0
  788. 7880 I&(I-641)=0:I&(I-640)=0
  789. 7890 NEXT
  790. 7900 GET@A(640,0)-(640+BX3,BY3*2+1),B
  791. 7910 FOR I&=0 TO 65535:I&(B(I&))=I&(B(I&))+1:NEXT
  792. 7920 I=0:FOR Y=BY TO BY2
  793. 7930 IF I&(I)=0 THEN I=I+1:GOTO 7930
  794. 7940 IF I&(I)>BX3 THEN LINE(BX,Y)-(BX2,Y),PSET,%I:I&(I)=I&(I)-BX4:GOTO 8000
  795. 7950 X=BX:WHILE X<=BX2
  796. 7960 IF I&(I)=0 THEN I=I+1:GOTO 7960
  797. 7970 IF I&(I)+X<BX2+1 THEN LINE(X,Y)-(X+I&(I)-1,Y),PSET,%I:X=X+I&(I):I&(I)=0:I=I+1
  798. 7980 IF I&(I)+X=>BX2+1 THEN LINE(X,Y)-(BX2,Y),PSET,%I:I&(I)=I&(I)-BX2+X-1:X=BX2+1
  799. 7990 WEND
  800. 8000 NEXT:RETURN
  801. 8010 *BE I=VAL(A$)
  802. 8020 IF I<3 THEN LINE(BX,BY)-(BX2,BY2),AND,%255-4*8^(2-I),BF
  803. 8030 IF I=>4 AND I=<6 THEN LINE(BX,BY)-(BX2,BY2),AND,%255-8^(6-I),BF
  804. 8040 IF I>6 THEN LINE(BX,BY)-(BX2,BY2),AND,%255-2*8^(9-I),BF
  805. 8050 RETURN
  806. 8060 *WAVEX GOSUB *WI3
  807. 8070 FOR I=0 TO BY3:GET@A(0,I)-(BX3,I),B
  808. 8080 X=COS(3.14159!/19*I)*16:PUT@A(X,I)-(BX3+X,I),B
  809. 8090 NEXT:GOTO *W
  810. 8100 *WAVEY GOSUB *WI3
  811. 8110 FOR I=0 TO BX3:GET@A(I,0)-(I,BY3),B
  812. 8120 X=COS(3.14159!/19*I)*16:PUT@A(I,X)-(I,BY3+X),B
  813. 8130 NEXT:GOTO *W
  814. 8140 *FANT GOSUB *MMI:GOSUB *MUON:I=1
  815. 8150 D(I)=MOUSE(0):D(I+1)=MOUSE(1)
  816. 8160 IF MOUSE(2,0)=0 THEN 8150
  817. 8170 I=I+2:IF I>16000 THEN 8240
  818. 8180 IF MOUSE(2,0) THEN 8180
  819. 8190 D(I)=MOUSE(0):D(I+1)=MOUSE(1)
  820. 8200 LINE(D(I-2),D(I-1))-(D(I),D(I+1)),XOR,7
  821. 8210 IF MOUSE(2,0) THEN 8170
  822. 8220 LINE(D(I-2),D(I-1))-(D(I),D(I+1)),XOR,7
  823. 8230 IF MOUSE(2,1)=0 OR I=3 THEN 8190
  824. 8240 I=I-2:D(0)=(I-1)/2:X=V:GOSUB *ESC2:I=16384
  825. 8250 IF MOUSE(2,0) THEN 8250
  826. 8260 D(I)=MOUSE(0):D(I+1)=MOUSE(1)
  827. 8270 A$=INKEY$:IF A$=CHR$(27) OR A$=CHR$(23) THEN GOSUB *ESC
  828. 8280 IF A$=CHR$(8) OR A$=CHR$(9) OR A$=CHR$(22) THEN GOSUB *ESC2
  829. 8290 IF MOUSE(2,0)=0 THEN 8260
  830. 8300 I=I+2:D(0)=D(0)-1:IF D(0)=-1 THEN 8370
  831. 8310 IF MOUSE(2,0) THEN 8310
  832. 8320 D(I)=MOUSE(0):D(I+1)=MOUSE(1)
  833. 8330 LINE(D(I-2),D(I-1))-(D(I),D(I+1)),XOR,7
  834. 8340 IF MOUSE(2,0) THEN 8300
  835. 8350 LINE(D(I-2),D(I-1))-(D(I),D(I+1)),XOR,7
  836. 8360 GOTO 8320
  837. 8370 I=I-2:Y=V:GOSUB *ESCG:V=X:GOSUB *ESCP:GOSUB *WI3:EX=(I-16384)/2
  838. 8380 GOSUB *MO:GOSUB *MUSTP:GOSUB *PEI
  839. 8390 IF Y>X THEN Z=Y-X ELSE Z=EV+Y-X
  840. 8400 FOR I=0 TO Z
  841. 8410 FOR EY=0 TO EX-1
  842. 8420 LINE(D(EY*2+1)+(D(EY*2+16384)-D(EY*2+1))/Z*I,D(EY*2+2)+(D(EY*2+16385)-D(EY*2+2))/Z*I)-(D(EY*2+3)+(D(EY*2+16386)-D(EY*2+3))/Z*I,D(EY*2+4)+(D(EY*2+16387)-D(EY*2+4))/Z*I),PSET,%MP0
  843. 8430 NEXT:GOSUB *W:GOSUB *ESC:GOSUB *WI3:GOSUB *PEI
  844. 8440 NEXT:GOSUB *W:A$="":GOTO *MUON
  845. 8450 *印刷 HARDC 1,(BX\8,BY\19)-(BX2\8,BY2\19):RETURN
  846. 8460 *MAPM '****  Special MAP Mode  *************************
  847. 8470 IF MODE=0 THEN RETURN
  848. 8480 V(V&-V)=(V(V&-V)+1) MOD 3
  849. 8490 IF L>2 AND V(V&-V)>0 THEN EGX(L)=WX:EGY(L)=WY:GOSUB *EDG:L=2:XN2=8*2^L:YN2=8*2^L:GOSUB *MODE:GOSUB *EDP:GOSUB *拡大
  850. 8500 GOSUB *ESCG:GOSUB *ESCP:GOTO *MD
  851. 8510 *MMA Y=((MX-BX)\(BX4\16))*16+(MY-BY)\(BY4\16):V(V&-EV-1)=V
  852. 8520 IF M0 THEN MP0=Y:X=150:GOTO *MCS
  853. 8530 IF M1 THEN MP1=Y:X=170:GOTO *MCS
  854. 8540 RETURN
  855. 8550 *MLOAD IF MODE<>2 THEN RETURN
  856. 8560 LINE INPUT "LOAD MAP NAME ";A$:IF A$="" OR A$=" " THEN *字
  857. 8570 *MLO IF INSTR(A$,".")=0 THEN A$=A$+".MAP"
  858. 8580 LOAD@ A$,D
  859. 8590 PUT@A(BX,BY)-(BX2,BY2),D
  860. 8600 V(V&-V)=2:GOTO *字
  861. 8610 *MSAVE IF MODE<>2 THEN RETURN
  862. 8620 LINE INPUT "SAVE MAP NAME ";A$:IF A$="" OR A$=" " THEN *字
  863. 8630 IF INSTR(A$,".")=0 THEN A$=A$+".MAP"
  864. 8640 GET@A(BX,BY)-(BX2,BY2),D
  865. 8650 SAVE@ A$,D:GOTO *字
  866. 8660 *M拡大 I&=VARPTR(B(0)):EX=XK:EY=YK:MOUSE 1
  867. 8670 FOR Y=0 TO YN
  868. 8680 FOR X=0 TO XN
  869. 8690 PUT@A(EX,EY)-(EX+15,EY+15),V,,XB/16,YB/16,,V(V&-EV-1)*BX4*BY4\2+PEEK(I&+X+Y*256\YB)*128
  870. 8700 EX=EX+XB:NEXT:EX=XK:EY=EY+YB:NEXT
  871. 8710 IF MUSW THEN *MUON ELSE *MUSTP
  872.